home *** CD-ROM | disk | FTP | other *** search
/ Atari Mega Archive 1 / Atari Mega Archive - Volume 1.iso / tex / td187src.lzh / MTPOPUPS.I < prev    next >
Text File  |  1991-06-08  |  17KB  |  549 lines
  1. (*#######################################################################
  2.                             M A G I C P O P U P S
  3.   #######################################################################
  4.   V1.01  19.11.90  Peter Hellinger   Popups können jetzt analog zu
  5.                                      den MagicDials verschoben werden
  6.   V1.00  21.10.90  Peter Hellinger
  7.   V0.01  02.09.90  Peter Hellinger
  8.   #######################################################################*)
  9.  
  10. IMPLEMENTATION MODULE mtPopups;
  11.  
  12. (*------------------------------*)
  13. (*       COMPILERSWITCHES       *)
  14. (*------------------------------*)
  15. (*  TDI-Version:   DEAKTIVIERT  *)
  16. (*------------------------------*)
  17. (* V-  Overflow-Checks          *)
  18. (* R-  Range-Checks             *)
  19. (* S-  Stack-Check              *)
  20. (* N-  NIL-Checks               *)
  21. (* T-  TDI-Compiler vor 3.01    *)
  22. (* Q+  Branch statt Jumps       *)
  23. (*                              *)
  24. (*------------------------------*)
  25. (*  MM2-Version:     AKTIVIERT  *)
  26. (*------------------------------*)
  27. (*$R-   Range-Checks            *)
  28. (*$S-   Stack-Check             *)
  29. (*                              *)
  30. (*------------------------------*)
  31.  
  32.  
  33. FROM SYSTEM     IMPORT  ADDRESS, ADR;
  34. FROM Storage    IMPORT  ALLOCATE, DEALLOCATE;
  35. FROM MagicSys   IMPORT  Nil, Null, Bit0, Bit1, Bit2, Bit3, Bit4, Bit5, Bit6, Bit7,
  36.                         Bit8, Bit9, Bit10, Bit11, Bit12, Bit13, Bit14, Bit15,
  37.                         LOC, Byte, ByteSet, sWORD, sINTEGER, sCARDINAL, sBITSET,
  38.                         lWORD, lINTEGER, lCARDINAL, lBITSET,
  39.                         CastToChar, CastToByte, CastToByteset, CastToInt,
  40.                         CastToCard, CastToBitset, CastToWord, CastToLInt,
  41.                         CastToLCard, CastToLBitset, CastToLWord, CastToAddr;
  42. FROM MagicAES   IMPORT  GBOX, GTEXT, GBOXTEXT, GIBOX, GSTRING, GTITLE,
  43.                         Exit, DISABLED, OBJECT, ObjcDraw, ObjcFind, TEDINFO,
  44.                         BEGMCTRL, ENDMCTRL, WindUpdate, WFFULLXYWH, WindGet,
  45.                         FormButton, GrafHandle, MUKEYBD, MUBUTTON, MUM1, 
  46.                         MUM2, MUMESAG, MUTIMER, EvntMulti, AESIntIn, AESIntOut,
  47.                         AESCall;
  48. FROM mtAppl     IMPORT  VDIHandle, MouseOn, MouseOff, MouseArrow, MouseHand;
  49. FROM mtArea     IMPORT  AREA, NewAREA, DisposeAREA, FreeArea, SaveArea,
  50.                         CopyArea, RestoreArea, MOVEUP, MOVEDOWN, MOVELEFT,
  51.                         MOVERIGHT, MoveArea;
  52. FROM MagicStrings  IMPORT  Assign, Append, Length;
  53. IMPORT  MagicAES, MagicVDI;
  54.  
  55.  
  56. TYPE    tRect =         RECORD
  57.                          x: sINTEGER;
  58.                          y: sINTEGER;
  59.                          w: sINTEGER;
  60.                          h: sINTEGER;
  61.                         END;
  62.  
  63. TYPE    obTree =        POINTER TO ARRAY [0..1000] OF MagicAES.OBJECT;
  64.         tString =       ARRAY [0..40] OF CHAR;
  65.         tTedPtr =       POINTER TO TEDINFO;
  66.  
  67. VAR     Main:           ARRAY [0..51] OF OBJECT;
  68.         MainTitle:      TEDINFO;
  69.         Sub:            ARRAY [0..51] OF OBJECT;
  70.         SubTitle:       TEDINFO;
  71.         mainArea:       AREA;
  72.         subArea:        AREA;
  73.         frontArea:      AREA;
  74.         SubBegin:       sINTEGER;
  75.         b:              sBITSET;
  76.         bool, rekExit:  BOOLEAN;
  77.         screen:         tRect;
  78.         chW, chH:       sINTEGER;
  79.         bW, bH:         sINTEGER;
  80.         mW, mH:         sINTEGER;
  81.  
  82.  
  83. PROCEDURE scanType (t: obTree; entry, flag: sINTEGER): sINTEGER;
  84. (* Scannt nach einem bestimmten Typflag *)
  85. VAR o, r: INTEGER;
  86. BEGIN
  87.  o:= entry;
  88.  WHILE (o >= entry)  DO
  89.   WITH t^[o] DO
  90.    IF flag = obType THEN  rekExit:= TRUE;  RETURN o;  END;
  91.    IF (obHead > -1) THEN
  92.     r:= scanType (t, obHead, flag);
  93.     IF rekExit THEN RETURN r; END;
  94.    END;
  95.    o:= obNext;
  96.   END;
  97.  END;
  98.  RETURN 0;
  99. END scanType;
  100.  
  101.  
  102. PROCEDURE SameLength (menu: obTree; num, max: sINTEGER);
  103. VAR i: sINTEGER;
  104. BEGIN
  105.  FOR i:= 0 TO num - 1 DO  menu^[i].obWidth:= max;  END;
  106. END SameLength;
  107.  
  108.  
  109. PROCEDURE PosMenu (menu: obTree; ob, maxW, maxH: sINTEGER);
  110. VAR x, y: sINTEGER;
  111.     b: sBITSET;
  112. BEGIN
  113.  WITH menu^[0] DO
  114.   IF ob > 0 THEN
  115.    x:= Main[0].obX + Main[ob].obX + (Main[ob].obWidth DIV 2);
  116.    y:= Main[0].obY + Main[ob].obY - (chW DIV 2);
  117.   ELSE
  118.    MagicAES.GrafMkstate (x, y, b, b);
  119.   END;
  120.   obX:= x;  obY:= y;  obWidth:= maxW;  obHeight:= maxH;
  121.   IF (obX + obWidth) > mW THEN  obX:= mW - obWidth - 1;  END;
  122.   IF (obY + obHeight) > mH THEN  obY:= mH - obHeight - 1;  END;
  123.   IF obX < screen.x THEN  obX:= screen.x + 1;  END;
  124.   IF obY < screen.y THEN  obY:= screen.y + 1;  END;
  125.  END;
  126. END PosMenu;
  127.  
  128.  
  129. PROCEDURE calcArea (tree: obTree; VAR frame: sINTEGER; VAR r: tRect);
  130. (* berechnet das umgebende Rechteck des Basis-Objekts *)
  131. VAR x: sINTEGER;
  132. BEGIN
  133.  frame:= ORD(tree^[0].Box.frame) + 1;
  134.  IF (frame > 127) THEN  frame:= 257 - frame;  END;
  135.  r.x:= tree^[0].obX - frame;
  136.  r.y:= tree^[0].obY - frame;
  137.  r.w:= tree^[0].obWidth + (frame * 2);
  138.  r.h:= tree^[0].obHeight + (frame * 2);
  139. END calcArea;
  140.  
  141.  
  142. PROCEDURE DoEvent (VAR x, y: sINTEGER;
  143.                    VAR button: sBITSET;
  144.                    VAR scan: sINTEGER): sBITSET;
  145. VAR event: sBITSET;
  146.     i:     sINTEGER;
  147.     split: RECORD
  148.             CASE: BOOLEAN OF
  149.              TRUE: wert: sINTEGER;|
  150.              FALSE: hi: CHAR;
  151.                     lo: CHAR;|
  152.             END;
  153.            END;
  154. BEGIN
  155.  (* Array's laden *)
  156.  event:= {MUKEYBD, MUTIMER, MUBUTTON};
  157.  AESIntIn[ 0]:= CastToInt (event);
  158.  AESIntIn[ 1]:= 257;
  159.  AESIntIn[ 2]:= 3;
  160.  AESIntIn[ 3]:= 0;
  161.  AESIntIn[14]:= 0;
  162.  AESIntIn[15]:= 0;
  163.  i:= AESCall(25, 16, 7, 1, 0);
  164.  event:= CastToBitset (i);
  165.  x:= AESIntOut[1];
  166.  y:= AESIntOut[2];
  167.  button:= CastToBitset (AESIntOut[3]);
  168.  (* kbshift:= CastToBitset (AESIntOut[4]); *)
  169.  split.wert:= AESIntOut[5];
  170.  scan:= CastToInt (split.hi);
  171.  (* ascii:= split.lo; *)
  172.  RETURN event;
  173. END DoEvent;
  174.  
  175.  
  176. PROCEDURE ScreenDim (VAR cw, ch, bw, bh, mw, mh: sINTEGER);
  177. VAR i: sINTEGER;
  178. BEGIN
  179.  MagicAES.GrafHandle (i, cw, ch, bw, bh);
  180.  MagicAES.WindGet (0, 7, screen);
  181.  mw:= screen.x + screen.w - 1;
  182.  mh:= screen.y + screen.h - 1;
  183. END ScreenDim;
  184.  
  185.  
  186. PROCEDURE Entprelle;
  187. VAR x, y:   sINTEGER;
  188.     button: sBITSET;
  189. BEGIN
  190.  REPEAT
  191.   MagicAES.GrafMkstate (x, y, button, b);
  192.  UNTIL button = {};
  193. END Entprelle;
  194.  
  195.  
  196.  
  197. PROCEDURE DoMenu (t: obTree; area: AREA): sINTEGER;
  198. CONST   Links =  Bit0;
  199.         Rechts = Bit1;
  200. VAR     x, y, ox, oy, i, f, j, o, d, xx, yy: sINTEGER;
  201.         ob, oldob, taste, scan, clicks: sINTEGER;
  202.         button, kbshift, event: sBITSET;
  203.         ascii: CHAR;
  204.         fr: tRect;
  205.  
  206.  PROCEDURE DrawBar (o: sINTEGER);
  207.  VAR r: tRect;
  208.  BEGIN
  209.   IF o > 0 THEN
  210.    r.x:= t^[0].obX + t^[o].obX;
  211.    r.y:= t^[0].obY + t^[o].obY;
  212.    r.w:= r.x + t^[o].obWidth - 1;
  213.    r.h:= r.y + t^[o].obHeight - 1;
  214.    MagicVDI.Bar (VDIHandle, r);
  215.   END;
  216.  END DrawBar;
  217.  
  218. BEGIN
  219.  i:= MagicVDI.SetWritemode (VDIHandle, MagicVDI.XOR);
  220.  i:= MagicVDI.SetFillcolor (VDIHandle, 1); 
  221.  bool:= MagicVDI.SetFillperimeter (VDIHandle, FALSE);
  222.  oldob:= -1;  ob:= -1;  ox:= -1;  oy:= -1;
  223.  WindUpdate (BEGMCTRL);
  224.  LOOP
  225.   event:= DoEvent (x, y, button, scan);
  226.   (* Objekt finden *)
  227.   IF (x # ox) OR (y # oy) THEN
  228.    ob:= MagicAES.ObjcFind (t, 0, 999, x, y);
  229.    ox:= x;
  230.    oy:= y;
  231.   END;
  232.   IF (MUKEYBD IN event) THEN
  233.    CASE scan OF
  234.     114,
  235.      28: (* Objekt selektiert *)
  236.          MouseOff;  DrawBar (oldob);  MouseOn;  EXIT;|
  237.      72: o:= ob;
  238.          IF o > 2 THEN
  239.           DEC (o);
  240.           IF (DISABLED IN t^[o].obState) THEN  DEC (o); END;
  241.           IF o >= 2 THEN  ob:= o;  END;
  242.          ELSE
  243.           ob:= t^[0].obTail;
  244.          END;
  245.          |
  246.      80: o:= ob;
  247.          IF (o < t^[0].obTail) AND (o > 1) THEN
  248.           INC (o);
  249.           IF (DISABLED IN t^[o].obState) THEN  INC (o); END;
  250.           IF o <= t^[0].obTail THEN  ob:= o;  END;
  251.          ELSE
  252.           ob:= 2;
  253.          END;
  254.          |
  255.      97: MouseOff;  DrawBar (oldob);  MouseOn;  ob:= -1;  EXIT;
  256.          |
  257.      ELSE ;
  258.    END;
  259.   END;
  260.   (* Rechte Maustaste? *)
  261.   IF (MUBUTTON IN event) AND